Mac-Source 1994 July/Mac-Source_July_1994.iso/Updates, etc./PG PRO⁄PG Lite Demos/PG PRO Demo/PG PRO Demo.rsrc/TEXT_3008_STR#.INCL.txt

Text File | 1993-09-10 | 19KB | 408 lines

'===============================================================================
'=                     Copyright 1992 Staz‚Ñ¢ Software, Inc.                     =
'=                             All rights reserved                             =
'=                           "STR#.INCL" from PG:PRO                           =
'===============================================================================
INCLUDE FILE _aplIncl
COMPILE 0,_MacsbugLabels_strResource_caseInsensitive'set by PG:PRO
GLOBALS "PG PRO.GLBL"'include standard global file
END GLOBALS
INCLUDE "@Header.INCL"
DEFSTR LONG
'===============================================================================
'  This set of functions has been designed to handle the work in manipulating
'  information in STR# resources.  Since PG:PRO's list manager CDEF uses
'  STR# resources to handle data for lists, the set is an important part of any
'  application that uses lists.
'
'  FN delElement(theElem,strID) -- deletes any element of a STR# resource
'
'  FN insElement(theElem,strID,theTxt$) -- inserts the string specified by
'     "theTxt$" before the element specified by "theElem" into a STR# resource
'
'  FN repElement(theElem,strID,theTxt$) -- replaces any element of a STR# res
'
'  FN apndElement(strID,theTxt$) -- adds an element to the end of a STR# res
'
'  FN sortStrRes(strID) -- sort a STR# resource... FAST!!
'
'  FN viewListItem(btnRefNum,itemToView) -- If you make a change to a STR# used
'     in one of PG's scrolling lists or wish to scroll to an item that is not
'     visible, call this function.
'
'  FN index2res(theIndx,strID) -- this function takes an INDEX$ array and
'     converts it to a STR# resource that is saved in the current file.
'
'  FN res2Index(theIndx,strID) -- this function takes a STR# resource and
'     converts it to an INDEX$ array.
'
'  FN newStr(strID,theText$) -- creates a new STR# resource with a single
'     element.
'
'  FN countStr(strID) -- this function returns the number of elements in a
'     STR# resource.
'
'  FN LMCDappend(btnRefNum,strID,theTxt$) -- Use this function to append
'     a string to one of PG's list manager controls.
'
'  FN LMCDremove(btnRefNum,strID) -- use this to remove a single line
'     from a scrolling list
'
'  FN LMCDfind(btnRefNum,strID,theTxt$) -- this function locates a
'     string in a scrolling list and returns the element number for
'     that string.  If the string is not found, the function returns
'     zero.
'
'===============================================================================
'_______________________________________________________________________________
LOCAL FN chkResErr'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM t$(1)
rError = FN RESERROR
LONG IF rError
t$(0)="CHANGERESOURCE failed."+CHR$(13)+"The modified resource could not be marked as changed."
t$(1) = "STR# Error"
CALL PARAMTEXT(t$(0),t$(1),"","")
FN pGshowErr(0)
END IF
END FN = rError
'_______________________________________________________________________________
'_______________________________________________________________________________
LOCAL FN delElement(theElem,theID)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
resHndl&   = FN GETRESOURCE(_"STR#",theID)
boolError  = _noErr
LONG IF resHndl&
delLgth  = LEN(STR#(theID,theElem)) + 1
LONG IF delLgth -1
hState = FN HGETSTATE(resHndl&)
OSErr  = FN HNOPURGE(resHndl&)
dest&  = USR STROFFSET(theElem,theID)
src&   = dest& + delLgth
mvSz&  = FN GETHANDLESIZE(resHndl&) - src&
BLOCKMOVE [resHndl&]+src&,[resHndl&] + dest&,mvSz&
newSz& = FN GETHANDLESIZE(resHndl&) - delLgth
OSErr  = FN SETHANDLESIZE(resHndl&,newSz&)
% [resHndl&],{[resHndl&]}-1
resHndl& = FN STRIPADDRESS(resHndl&)
CALL CHANGEDRESOURCE(resHndl&)
boolError = FN chkResErr
OSErr  = FN HSETSTATE(resHndl&,hState)
END IF
END IF
END FN = boolError
'_______________________________________________________________________________
LOCAL FN insElement(theElem,theID,theTxt$)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
resHndl&  = FN GETRESOURCE(_"STR#",theID)
boolError = _noErr
LONG IF resHndl&
hState  = FN HGETSTATE(resHndl&)
OSErr   = FN HNOPURGE(resHndl&)
insLgth = LEN(theTxt$) + 1
oldSz&  = FN GETHANDLESIZE(resHndl&)
newSz&  = oldSz& + insLgth
src&    = USR STROFFSET(theElem,theID)
dest&   = src&   + insLgth
mvSz&   = oldSz& - src&

LONG IF FN SETHANDLESIZE(resHndl&,newSz&) = 0
BLOCKMOVE [resHndl&]+src&,[resHndl&] + dest&,mvSz&
BLOCKMOVE @theTxt$,[resHndl&]+src&,insLgth
% [resHndl&],{[resHndl&]}+1
resHndl& = FN STRIPADDRESS(resHndl&)
CALL CHANGEDRESOURCE(resHndl&)
boolError = FN chkResErr
END IF

OSErr   = FN HSETSTATE(resHndl&,hState)
END IF
END FN = boolError
'_______________________________________________________________________________
LOCAL FN repElement(theElem,theID,theTxt$)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
boolError = FN delElement(theElem,theID)
LONG IF boolError = _noErr
boolError = FN insElement(theElem,theID,theTxt$)
END IF
END FN = boolError
'_______________________________________________________________________________
LOCAL FN apndElement(theID,theTxt$)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
resHndl& = FN GETRESOURCE(_"STR#",theID)
boolError = _noErr
LONG IF resHndl&
hState = FN HGETSTATE(resHndl&)
OSErr  = FN HNOPURGE(resHndl&)
DEF APNDSTR(theTxt$,resHndl&)
resHndl& = FN STRIPADDRESS(resHndl&)
CALL CHANGEDRESOURCE(resHndl&)
boolError = FN chkResErr
OSErr  = FN HSETSTATE(resHndl&,hState)
END IF
END FN = boolError
'_______________________________________________________________________________
LOCAL FN sortStrRes(theID)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
XREF @aryHndl&(32000)
boolError = _zTrue
resHndl&  = FN GETRESOURCE(_"STR#",theID)

LONG IF resHndl&
hState  = FN HGETSTATE(resHndl&)
OSErr   = FN HLOCK(resHndl&)
elemCnt = {[resHndl&]}
LONG IF elemCnt > 1
aryHndl& = FN NEWHANDLE _clear((elemCnt+1)*4)
ptr& = [resHndl&]+2
FOR pstrLoop = 1 TO elemCnt
aryHndl&(pstrLoop) = ptr&
ptr& = ptr& + PEEK(ptr&) + 1
NEXT pstrLoop
'=================================================================
gap = elemCnt
DO
    gap = gap/1.3
    IF gap < 1 THEN gap = 1
    switch = _false
    FOR sortLoop = 1 TO elemCnt - gap
        test = sortLoop + gap
        LONG IF PSTR$(aryHndl&(sortLoop)) > PSTR$(aryHndl&(test))
            SWAP aryHndl&(sortLoop),aryHndl&(test)
            switch = _zTrue
        END IF
    NEXT sortLoop
UNTIL switch =_false AND gap=1
'=================================================================
theSize& = FN GETHANDLESIZE(resHndl&)
LONG IF theSize&
newRes&  = FN NEWHANDLE(theSize&)
LONG IF newRes&
OSErr = FN HLOCK(newRes&)
% [newRes&],elemCnt
ptr& = [newRes&]+2

FOR refill = 1 TO elemCnt
l = PEEK(aryHndl&(refill))+1
BLOCKMOVE aryHndl&(refill),ptr&,l
ptr& = ptr& + l
NEXT

BLOCKMOVE [newRes&],[resHndl&],theSize&
resHndl& = FN STRIPADDRESS(resHndl&)
CALL CHANGEDRESOURCE(resHndl&)
boolError = FN chkResErr
DEF DISPOSEH(newRes&)
END IF

DEF DISPOSEH(aryHndl&)
END IF
END IF
OSErr  = FN HSETSTATE(resHndl&,hState)
END IF
END FN = boolError
'_______________________________________________________________________________
LOCAL FN viewListItem(btnRefNum,itemToView)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM localRect;0,t,l,b,r
oldValue  = BUTTON(btnRefNum)'save old button value
ctrlHndl& = BUTTON&(btnRefNum)'get control handle
LONG IF ctrlHndl&
multiCol  = {[[[ctrlHndl&]+_contrlData]]+36}'1 if multi col
numRows   = {[[[ctrlHndl&]+_contrlData]]+40}'number of rows visible
topItem   = {[[[ctrlHndl&]+_contrlData]]}'top item visible
strID     = {[[[ctrlHndl&]+_contrlData]]+2}'ID of STR# resource
resHndl&  = FN GETRESOURCE(_"STR#",strID)'handle to STR res
LONG IF resHndl&'got a handle?
strCount = {[resHndl&]}'extract element count
% [ctrlHndl&]+_contrlmax,strCount-1'
IF itemToView > strCount THEN itemToView = strCount
IF itemToView < 1 + multiCol THEN itemToView = 1 + multiCol

END IF'check new value

viewAdj = 1 - multiCol
LONG IF itemToView - viewAdj < topItem'above top item?
% [[[ctrlHndl&]+_contrlData]],itemToView - viewAdj'reset top item
END IF

LONG IF itemToView > topItem + numRows + 1'below lowest visible item?
% [[[ctrlHndl&]+_contrlData]],itemToView - (numRows + 1)
END IF'reset top to make it visible

LONG IF itemToView = oldValue'no change in value?
localRect;8=[ctrlHndl&]+_contrlRect
CALL INSETRECT(localRect,1,1)
CALL INVALRECT(localRect)'invalidate to force redraw
l=r+1:r=l+14
CALL INVALRECT(localRect)'invalidate to force redraw
XELSE'otherwise
BUTTON btnRefNum,itemToView'have FB update it
END IF
END IF
END FN
'_______________________________________________________________________________
LOCAL FN index2res(theIndx,resID)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
strHndl& = FN NEWHANDLE _clear(2)
LONG IF strHndl&
elemCount = MEM(10 + theIndx) - 1
FOR loop = 0 TO elemCount
t$ = INDEX$(loop,theIndx)
DEF APNDSTR(t$,strHndl&)
NEXT
FN pGreplaceRes(strHndl&,_"STR#",resID,"")
END IF
END FN
'_______________________________________________________________________________
LOCAL FN res2Index(theIndx,resID)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
resHndl& = FN GETRESOURCE(_"STR#",resID)
LONG IF resHndl&
theSize& = FN GETHANDLESIZE(resHndl&) + 1024
theCount = {[resHndl&]}
CLEAR INDEX$ theIndx
CLEAR theSize&, theIndx
FOR loop = 1 TO theCount
INDEX$(loop-1,theIndx) = STR#(resID,loop)
NEXT
END IF
END FN
'_______________________________________________________________________________
LOCAL FN newStr(strID,theText$)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
resHndl& = FN NEWHANDLE _clear(2)
DEF APNDSTR(theText$,resHndl&)
FN pGreplaceRes(resHndl&,_"STR#",strID,"")
END FN
'_______________________________________________________________________________
LOCAL FN countStr(strID)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
resHndl& = FN GETRESOURCE(_"STR#",strID)
LONG IF resHndl&
theCount = {[resHndl&]}
XELSE
theCount = 0
END IF
END FN = theCount
'_______________________________________________________________________________
DEF FN parseToComma(@srcStr&) USING "Parse To Comma"'∑∑œœœœœœœœœœœœœœœœœœœœœœœ∑∑
'———————————————————————————————————————————————————————————————————————————————
GOTO"After Parse To Comma"
"Parse To Comma"
'--------------------------------------------------------------------------
'  This function searches for a comma and truncates the string
'  to eliminate the comma and all following characters.
'
'      EXAMPLE     src$  = "one,two,three"
'                  fn parseToComma(src$)
'                  src$ is now equal to "one"
'
'       D0 Original string address
'       D1 Character count
'       D2 This character
'       A0 Points to present string pos
'--------------------------------------------------------------------------
`             MOVE.L  D0,A0             ;address to A0
`             MOVEQ   #0,D1             ;clear D1,D2
`             MOVEQ   #0,D2
`             MOVE.B  (A0)+,D1          ;get string length
`             BEQ.S   parseDone         ;empty string
`             SUBQ    #1,D1             ;decrement for DBRA
`notYet       MOVE.B  (A0)+,D2          ;get next character
`             CMPI.B  #',',D2           ;is it a comma?
`             BEQ.S   foundComma        ;yep - exit
`             DBRA    D1,notYet         ;nope - keep looking
`             BRA.S   parseDone         ;never found it
`foundComma   ADDQ    #1,D1             ;reverse the -1 used for DBRA
`             MOVE.L  D0,A0             ;get original address
`             SUB.B   D1,(A0)           ;use for length byte
`parseDone    RTS                       ;done
"After Parse To Comma"
'_______________________________________________________________________________
LOCAL FN parseFromComma$(@srcStr&)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
'  This function searches for a comma and moves the following characters
'  of the string into a target string.
'
'      EXAMPLE     src$  = "one,two,three"
'                  dest$ = fn parseFromComma(src$)
'                  dest$ is now equal to "two,three"
'
'       A0 Original string address (After move on entry)
'       A1 Target String
'       D0 Source string size
'       D1 Dest string byte count
'       D2 Character being checked
'--------------------------------------------------------------------------
`             MOVE.L  D0,A0             ;source address to A0
`             LEA     ^t$,A1            ;target address in A1
`             MOVE.B  #0,(A1)+          ;default - no text found
`             MOVEQ   #0,D0             ;clear D0-D2
`             MOVEQ   #0,D1
`             MOVEQ   #0,D2

`             MOVE.B  (A0)+,D0          ;get string length
`             BEQ.S   noComma           ;empty string
`             SUBQ    #1,D0             ;decrement for DBRA
`keepLokn     MOVE.B  (A0)+,D2          ;get next character
`             CMPI.B  #',',D2           ;is it a comma?
`             BEQ.S   gotComma          ;yep - exit
`             DBRA    D0,keepLokn       ;nope - keep looking
`             BRA.S   noComma           ;never found it

`gotComma     MOVE.B  (A0)+,(A1)+       ;first move is actually comma
`             ADDQ    #1,D1             ;increment our string counter
`             DBRA    D0,gotComma       ;go till done
`             SUBQ    #1,D1             ;adjust - added in the comma byte
`             LEA     ^t$,A1            ;load string address again
`             MOVE.B  D1,(A1)           ;set length byte

`noComma
'--------------------------------------------------------------------------
END FN = t$
'_______________________________________________________________________________
LOCAL FN LMCDappend(btnID,resID,theTxt$)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
boolError = _noErr
LONG IF STR#(resID,BUTTON(btnID)) = "Empty List"
FN newStr(resID,theTxt$)
XELSE
FN apndElement(resID,theTxt$)
END IF
FN viewListItem(btnID,FN countStr(resID))
END FN = boolError
'_______________________________________________________________________________
LOCAL FN LMCDremove(btnID,resID)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
boolError = _noErr
LONG IF STR#(resID,BUTTON(btnID)) = "Empty List"
BEEP
XELSE
LONG IF FN countStr(resID) = 1
FN newStr(resID,"Empty List")
XELSE
FN delElement(BUTTON(btnID),resID)
END IF
END IF
LONG IF BUTTON(btnID) > FN countStr(resID)
BUTTON btnID,FN countStr(resID)
XELSE
FN viewListItem(btnID,BUTTON(btnID))
END IF
END FN = boolError
'_______________________________________________________________________________
LOCAL FN LMCDfind(btnID,resID,theTxt$)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
STRfound = _false
theCount = FN countStr(resID)
FOR loop = 1 TO theCount
LONG IF theTxt$ = STR#(resID,loop)
LONG IF BUTTON(btnID) <> loop
FN viewListItem(btnID,loop)
END IF
STRfound = loop
loop = theCount
END IF
NEXT
END FN = STRfound